VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDbLoad"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


'barb: where to keep these?
'these were public in dbloadproject
Private iMsgCount As Integer
Private strErrMsg As String
Private strLogMsg As String
Public Line As String


Public Function ReadFile(PathFileName As String, _
                        strFixedStringHeader As String, _
                        strFooter As String, _
                        arRecords() As Variant) As Boolean

Dim strFileString As String
Dim FNumber As Long
Static FileLineCount As Long

'Dim arHeader()
'Dim arFooter() As Variant
'Dim colRecords As Collection
Dim strSingleRecord As String

On Error GoTo Readfile_Fix

'GET NEXT FILENUMBER
FNumber = FreeFile


'READ FILE
Open PathFileName For Input As FNumber
     'READ HEADER FROM FILE
    Line Input #FNumber, strFileString
    'PROCESS FILE DATA
    If GetHeader(strFileString, strFixedStringHeader) Then

        Do While Not EOF(FNumber)
            'READ A LINE FROM FILE
            Line Input #FNumber, strFileString
            If strFileString <> "" Then
                'PROCESS FILE DATA
                If GetRecord(strFileString, strSingleRecord) Then
                    FileLineCount = FileLineCount + 1
                    ReDim Preserve arRecords(FileLineCount)
                    arRecords(FileLineCount) = strSingleRecord
                    Line = FileLineCount & "," & strFileString
                End If
                
            End If
        Loop
    Else
        ReadFile = False
    End If
Close #FNumber
strFooter = arRecords(UBound(arRecords))
ReDim Preserve arRecords(UBound(arRecords) - 1)
FileLineCount = FileLineCount - 1

'If ValidateFileSections Then
'
'End If

ReadFile = True

Exit Function

Readfile_Fix:
    ReadFile = False
End Function
Private Function GetHeader(FileStmt As String, strFixedHeader As String) As Boolean

Dim intPos As Integer
Dim iColCount As Integer

On Error GoTo GetHeaderFix

    iColCount = 0
    'CHECK THAT THIS IS THE HEADER
    'new: no columns or quotes in file string
    If Mid(FileStmt, 1, 1) <> "H" Then
        MsgBox "HEADER ERROR"
        GetHeader = False
        Exit Function
    End If
    
    strFixedHeader = FileStmt

If Len(strFixedHeader) <> 79 Then
    GetHeader = False
Else
    GetHeader = True
End If

Exit Function

GetHeaderFix:
    GetHeader = False
    If frmTest.strErrPathFile <> "" Then
        WriteErrorMsg Line, "GetHeader" & " " & Err.Number & " " & Err.Description
    End If
End Function

Private Function GetFooter(strFileStmt As String, strFooter As String) As Boolean

Dim intPos As Integer
Dim iColCount As Integer

On Error GoTo GetFooter_Fix

If Mid(strFileStmt, 1, 1) <> "T" Then
    GetFooter = False
    Exit Function
End If


    strFooter = strFileStmt

If Len(strFooter) <> 165 Then
    GetFooter = False
Else
    GetFooter = True
End If

Exit Function

GetFooter_Fix:
    GetFooter = False
    If frmTest.strErrPathFile <> "" Then
        WriteErrorMsg Line, "GetFooter " & " " & Err.Number & " " & Err.Description
    End If
End Function

Private Function GetRecord(FileStmt As String, strFixedRecord As String) As Boolean

Dim intPos As Integer
Dim iColCount As Integer

Dim arLastRecord()

On Error GoTo GetRecordFix
    
    If Mid(FileStmt, 1, 1) <> "R" Then
        If Mid(FileStmt, 1, 1) = "T" Then
            If GetFooter(FileStmt, strFixedRecord) Then
                GetRecord = True
                Exit Function
            Else
                GoTo GetRecordFix
            End If
        Else
            GoTo GetRecordFix
        End If
        GoTo GetRecordFix
    End If
    
    strFixedRecord = FileStmt

    If Len(strFixedRecord) = 250 Then   '1315 including chr(13)
        GetRecord = True
    Else
        GetRecord = False
    End If
Exit Function

GetRecordFix:
    MsgBox "Record Error"
    GetRecord = False
    If frmTest.strErrPathFile <> "" Then
        WriteErrorMsg Line, "GetRecord" & " " & Err.Number & " " & Err.Description
    End If
End Function



Public Sub WriteErrorMsg(FLine As String, BreakLoc As String)
    
    Dim FNum As Long
    Dim FName As String
    Dim ExistingFiles As String
    Dim LastFileName As String
    Dim strCurrentNumber As String
    Dim lNextNumber As Long
    
    iMsgCount = iMsgCount + 1
    strErrMsg = iMsgCount & "," & FLine & "," & BreakLoc & Chr(13)
    'MsgBox strErrMsg
    
    FNum = FreeFile
    FName = frmTest.strErrPathFile
    
    Open FName For Append As FNum
    Write #FNum, strErrMsg
    Close #FNum

End Sub

Public Sub WriteLogMsg(LogMsg As String)
    
    Dim FNum As Long
    Dim FName As String
    Dim ExistingFiles As String
    Dim LastFileName As String
    Dim strCurrentNumber As String
    Dim lNextNumber As Long
    
    strLogMsg = LogMsg & Chr(13)
    'MsgBox strLogMsg
    
    FNum = FreeFile
    FName = frmTest.strLogPathFile

    Open FName For Append As #FNum
    Write #FNum, LogMsg
    Close #FNum

End Sub

Private Function ValidateHeader(arHeader) As Boolean

    Dim SEC_ID As String
    Dim INFO_TYPE As String ', len:8, juxt: left, PADDED: BLANK
    Dim INFO_SUBTYPE As String ', len:8, must contain blanks
    Dim TEST_DATA As String ', LEN:1, TEST DATA _ 'Y' = NOT FOR PROD DB AND MUST BE REJECTED
    Dim FILE_SERIES_CTL As String ', LEN:1, MUST ALWAYS BE 'S'
    Dim EXT_SYS As String ', LEN:8, JUXT: LEFT, PADDED: BLANK, (id of REQUESTOR _ ISP0901)
    Dim VER_NO As Long ', LEN:8, JUXT:RIGHT, (this no increases whenever there is a change to this file layout)
    Dim OWN_FILE_ID As String ', LEN:14, JUXT:LEFT, PADDED:BLANK (ALPHANUM _ sender's no to uniquely id file
    Dim GEN_TIME As Date ', LEN:14, (DATETIME: CCYYMMDD hhmmss)
    Dim ELECT_RESP As String ', LEN:1, (Either this field or next must be 'Y', if both = 'N', then make
    Dim PAPER_RESP As String ', LEN:1,  if both = 'N', then make PAPER_RESP = 'Y'


'barb:start here h,r,t
'chr(13)
'count recs for each


    '    strBuild = "'H',"                       'SEC-ID
'    strBuild = strBuild & "'FORMC   ',"      'INFO-TYPE, len:8, juxt: left, PADDED: BLANK
'    strBuild = strBuild & "        ,"        'INFO-SUBTYPE, len:8, must contain blanks
'    strBuild = strBuild & "'N',"             'TEST-DATA, LEN:1, TEST DATA - 'Y' = NOT FOR PROD DB AND MUST BE REJECTED
'    strBuild = strBuild & "'S',"             'FILE-SERIES-CTL, LEN:1, MUST ALWAYS BE 'S'
'    strBuild = strBuild & "'ISP0901',"       'EXT-SYS, LEN:8, JUXT: LEFT, PADDED: BLANK, (id of REQUESTOR - ISP0901)
'    strBuild = strBuild & "'1',"             'VER-NO, LEN:8, JUXT:RIGHT, (this no increases whenever there is a change to this file layout)
'
'    strBuild = strBuild & "'" & GetNextFileName & "',"                'OWN-FILE-ID, LEN:14, JUXT:LEFT, PADDED:BLANK (ALPHANUM - sender's no to uniquely id file
'
'    Set rsDate = objAdoConn.Connection.Execute("Select GetDate()")
'    strBuild = strBuild & "'" & rsDate(0) & "',"                'GEN-TIME, LEN:14, (DATETIME: CCYYMMDD hhmmss)
'    strBuild = strBuild & "Y,"                'ELECT-RESP, LEN:1, (Either this field or next must be 'Y', if both = 'N', then make
'    strBuild = strBuild & "Y"                'PAPER-RESP, LEN:1,  if both = 'N', then make PAPER-RESP = 'Y'
'
'    CreateHeaderRecord = strBuild
End Function
Public Function PerformInsert(arFileData As Variant) As Boolean

    Dim lngRecordsAffected As Long
    Dim strSql As String
    Dim rsExistingReference As ADODB.Recordset
    Dim i As Long

    For i = 1 To UBound(arFileData)

        strSql = "Select REQ_SEQ_NUM from DIR_REQUEST_FORMS where REQ_SEQ_NUM = " & arFileData(i)(0)
        Set rsExistingReference = objAdoConn.Connection.Execute(strSql)
        If rsExistingReference.RecordCount > 0 Then
            
            strSql = "Insert into DIR_RESPONSE ("
            strSql = strSql & " REQ_SEQ_NUM,"
            strSql = strSql & " REQUEST_STATUS,"
            strSql = strSql & " EMAILED_YN,"
            strSql = strSql & " SARS_APPL_ID,"
            strSql = strSql & " INCOME_TAX_AREA_CODE,"
            strSql = strSql & " DIRECTIVE_NUMBER,"
            strSql = strSql & " DECLINE_REASON,"
            strSql = strSql & " ISSUE_DATE,"
            strSql = strSql & " DIR_START_DATE,"
            strSql = strSql & " DIR_END_DATE,"
            strSql = strSql & " TAX_PERCENTAGE,"
            strSql = strSql & " TAX_FREE_PORTION,"
            strSql = strSql & " GROSS_AMOUNT_PAYE,"
            strSql = strSql & " DEDUCTION_FREQUENCY,"
            strSql = strSql & " VAT_REGISTRATION_NUMBER,"
            strSql = strSql & " VAT_AMOUNT,"
            strSql = strSql & " PAYE_AMT,"
            strSql = strSql & " CREATED_DATE,"
            strSql = strSql & " CREATED_BY)"
            strSql = strSql & " values("
            strSql = strSql & arFileData(i)(0) & ", "
            strSql = strSql & arFileData(i)(5) & ", "
            strSql = strSql & "'N', "
            strSql = strSql & arFileData(i)(1) & ", "
            strSql = strSql & arFileData(i)(2) & ", "
            strSql = strSql & arFileData(i)(4) & ", "
            strSql = strSql & arFileData(i)(6) & ", "
            strSql = strSql & arFileData(i)(7) & ", "
            strSql = strSql & arFileData(i)(8) & ", "
            strSql = strSql & arFileData(i)(9) & ", "
            strSql = strSql & arFileData(i)(12) & ", "
            strSql = strSql & arFileData(i)(13) & ", "
            strSql = strSql & arFileData(i)(14) & ", "
            strSql = strSql & arFileData(i)(15) & ", "
            strSql = strSql & arFileData(i)(20) & ", "
            strSql = strSql & arFileData(i)(21) & ", "
            strSql = strSql & arFileData(i)(23) & ","
            strSql = strSql & " GETDATE(),"
            strSql = strSql & " 'KtInsert')"
            
            
            objAdoConn.Connection.Execute strSql, lngRecordsAffected
            If lngRecordsAffected <> 1 Then
                PerformInsert = False
            Else
                If UpdateDir_Request_FormsStatus(arFileData(i)(0), i) Then
                    PerformInsert = True
                Else
                    PerformInsert = False
                End If
            End If
        Else
            PerformInsert = False
        End If

    Next i

End Function
Private Function UpdateDir_Request_FormsStatus(Req_Seq_No, RecLineNo As Long) As Boolean

'   Updates scod status from Captured to Extracted and saves
'   extracted date

    Dim strSql As String
    Dim lngRecordsAffected As Long
    
    On Error GoTo UpdateDir_Request_FormsStatus_Fix
    
    strSql = "Update DIR_REQUEST_FORMS set SCOD_STATUS = 'R' , STATUS_DATE = GETDATE() where REQ_SEQ_NUM = '" & Req_Seq_No & "'"
    objAdoConn.Connection.Execute strSql, lngRecordsAffected
    If lngRecordsAffected <> 1 Then
        HandleError 0, "Update Dir_Request_Forms(Scod_Status) failed.", "GetRecords", "Insert failed on REQ_SEQ_NUM: " & Req_Seq_No & "."
        UpdateDir_Request_FormsStatus = False
    Else
        UpdateDir_Request_FormsStatus = True
    End If
Exit Function
UpdateDir_Request_FormsStatus_Fix:
    HandleError Err.Number, Err.Description, "UpdateDir_Request_FormsStatus"
    UpdateDir_Request_FormsStatus = False
    'barb: have global type err stuff
    'save error fileline no here - maybe don't print
End Function
